#!../mlisp

; usage: prove test.arc

;; test framework

(load "arc.arc")

(set *test-results* '())

(def begin-test ()
  (set *test-results* '()))

(def end-test ()
  (when *test-results*
    (pr "1.." (len *test-results*) "\n")
    (map1 pr (rev *test-results*))))

(mac push (x ls)
  `(set ,ls (cons ,x ,ls)))

(mac pop (ls)
  `(do1
    (car ,ls)
    (set ,ls (cdr ,ls))))

(def test (got expected test-name)
  (with (ls '()
         res (and (isa got (type expected))
                  (or (iso got expected)
                      (== got expected))))
    (push (if res "ok" "not ok") ls)
    (push " # " ls)
    (push test-name ls)
    (push "\n" ls)
    (when (no res)
      (push (string "# got:      " got "\n") ls)
      (push (string "# expected: " expected "\n") ls))
    (push (apply string (rev ls)) *test-results*)))

;;;; test

(begin-test)

(test (cons 1 2) '(1 . 2) 'cons)
(test (car '(1 . 2)) 1 'car)
(test (cdr '(1 . 2)) 2 'cdr)
(test (car nil) nil 'car-nil)
(test (cdr nil) nil 'cdr-nil)

(test 'foo 'foo 'symbol)
(test (+ 1 2) 3 '+)
(test (- 1) -1 'unary-minus)
(test (if 1 2 3) 2 'if-true)
(test (if nil 2 3) 3 'if-else)
(test ((fn (x) x) 1) 1 'fn)
(test (((fn (x) (fn (y) (+ x y))) 1) 2) 3 'closure)
(test ([+ _ 1] 2) 3 'reader-macro)
(test ((fn (割られる数 割る数) (/ 割られる数 割る数)) 10 2) 5 'multi-byte-character)

(set x 100)
(mac mactest (y) `(+ ,x ,y))
(test (let x 1234 (mactest 1)) 101 'mac)
(test (let x 1234 (macex '(mactest 1))) '(+ 100 1) 'macex)

(test (eval '(+ 1 2)) 3 'eval)
(set x 1)
(test (let x 2 (eval 'x)) 1 'eval-isnt-shadowed-by-local-environment)

(test (mod  5  2)  1 'mod++)
(test (mod -5  2)  1 'mod-+)
(test (mod  5 -2) -1 'mod+-)
(test (mod -5 -2) -1 'mod--)

(test (len '(a b c))     3 'len3)
(test (len '())          0 'len0)
(test (len '(a b c . d)) 3 'len-dotted)

(test (rev '(1 2 3)) '(3 2 1) 'reverse)
;(test (rev '(1 2 . 3)) '(2 1) 'reverse-dotted-list)  ; This cause error


; literal
(test #x0100 256 'hex-decimal)
(test #b1010 10  'binary-decimal)
(test #o777  511 'oct-decimal)
(test +1     1   'plus)

; floating-point
(test 1.0     1.0   'fp)
(test 1.      1.0   'fp-no-frac-part-is-same-as-num)
(test .1      0.1   'fp-no-int-part)
(test 1.23e1  12.3  'fp-exp+)
(test 1.23e-1 0.123 'fp-exp-)



; case
(test (map1 (fn (x) (case x 1 'one 2 'two 'other)) 
            '(1 2 3))
      '(one two other)
      'case)


;; backquote
(def abs (x) (if (< x 0) (- x) x))

(test (let x 'a `(x ,x ',x))
      '(x a 'a)
      'bq0)
#|
(test `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)
      '(a 3 4 5 6 b)
      'bq1)
;(test `(( foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))
;      '((foo 7) . cons)
;      'bq2)
(test (with (name1 'x
             name2 'y)
        `(a `(b ,,name1 ,',name2 d) e))
      '(a `(b ,x ,'y d) e)
      'bq3)
|#



;; char
(test #\a #\a 'char)
(test (string-ref "string" 0) #\s 'string-ref)


;; coerce
(test (coerce "string" 'string) "string" 'string->string)
(test (coerce 123 'string) "123" 'int->string)
(test (coerce 123.4 'string) "123.4" 'float->string)
(test (coerce #\a 'string) "a" 'char->string)
(test (coerce 'symbol 'string) "symbol" 'int->string)
(test (coerce '(#\a #\b #\c) 'string) "abc" 'cons->string)

(test (coerce 123 'int) 123 'string->int)
(test (coerce "123" 'int) 123 'string->int)
(test (coerce #\a 'int) 97 'char->int)
(test (coerce 123.4 'int) 123 'string->int)

(test (coerce 123.4 'num) 123.4 'string->float)
(test (coerce "123.4" 'num) 123.4 'string->float)

(test (coerce 'symbol 'sym) 'symbol 'string->symbol)
(test (coerce "string" 'sym) 'string 'string->symbol)

(test (coerce '(1 2 3) 'cons) '(1 2 3) 'cons->cons)
(test (coerce "string" 'cons) '(#\s #\t #\r #\i #\n #\g) 'string->cons)

(test (coerce #\a 'char) #\a 'char->char)
(test (coerce 97 'char) #\a 'int->char)

(end-test)
